library(tidyverse)
library(janitor)
library(naniar)
library(ggmap)
library(shiny)
library("tidyverse")
library("naniar")
library("janitor")
library("stringr")
library(tidyverse)
library(janitor)
library(naniar)
library(tidyverse)
library(skimr)
library(janitor)
library(palmerpenguins)
library(gtools)
library(RColorBrewer)
library(paletteer)
library(ggthemes)
options(scipen = 999)
locations <- read.csv("data/Health_Facility_General_Information.csv") %>%
clean_names()
cardiac <- read_csv("data/cardiac-surgery.csv") %>%
clean_names() %>%
filter(facility_id!=0) %>%
mutate(hospital_name = ifelse(hospital_name == 'Albany Med. Ctr', 'Albany Medical Center', hospital_name), hospital_name = ifelse(hospital_name == 'Buffalo General Med Ctr', 'Buffalo General Hosp', hospital_name), hospital_name = ifelse(hospital_name == 'Bronx-Lebanon-Cncourse', 'Bronx-Lebanon-Concourse', hospital_name), hospital_name = ifelse(hospital_name == 'Brookdale Hosp Med Ctr', 'Brookdale Univ Hosp Med Ctr', hospital_name))
## Rows: 1609 Columns: 14
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (6): Hospital Name, Detailed Region, Region, Procedure, Year of Hospital...
## dbl (8): Facility ID, Number of Cases, Number of Deaths, Observed Mortality ...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
locations <- locations %>%
group_by(facility_id) %>%
summarise(across(everything(), first))
cardiac <- left_join(cardiac, locations, by="facility_id")
Have to separate the data, as some of them are over a range of a couple of years, some of them are year by year
cardiac <- cardiac %>%
filter(str_detect(year_of_hospital_discharge, "-", negate = TRUE))
year_data <- cardiac %>%
filter(str_detect(year_of_hospital_discharge, "-", negate = TRUE))
ranger_corps <- cardiac %>%
filter(str_detect(year_of_hospital_discharge, "-", negate = FALSE))
Map Data:
register_stadiamaps("e2de824a-0995-4a51-915c-33c14c061e7b", write = FALSE)
lat <- c(40.58, 44.70) #we got tehse values from summary above
long <- c(-78.87, -72.98)
bbox <- make_bbox(long, lat, f = 0.03)
maptotal <- get_stadiamap(bbox, maptype = "stamen_terrain", zoom=7) #Make ur basemap, there are other styles which you could find from this link, https://docs.stadiamaps.com/themes/
## ℹ © Stadia Maps © Stamen Design © OpenMapTiles © OpenStreetMap contributors.
x <- cardiac %>%
arrange(hospital_name) %>%
group_by(facility_id, hospital_name, facility_latitude, facility_longitude) %>%
summarise(number_of_cases=sum(number_of_cases), average_moratality_rate=mean(observed_mortality_rate), .groups = 'keep') %>%
mutate(total_deaths=average_moratality_rate/100*number_of_cases) %>%
mutate(facility_latitude=as.numeric(facility_latitude), facility_longitude=as.numeric(facility_longitude))
lat1 <- c(40.58, 41.2) #we got tehse values from summary above
long1 <- c(-74.5, -72.98)
bbox1 <- make_bbox(long1, lat1, f = 0.03)
mapnyc <- get_stadiamap(bbox1, maptype = "stamen_terrain", zoom=8)
## ℹ © Stadia Maps © Stamen Design © OpenMapTiles © OpenStreetMap contributors.
cardiac %>%
mutate(across(everything(), tolower)) %>%
mutate(across(everything(), ~ str_replace_all((.), " ", "_"))) %>%
mutate(across(everything(), ~ str_replace_all((.), "__", "_"))) %>%
mutate(across(-"year_of_hospital_discharge", ~ str_remove((.), "-"))) %>%
mutate(across(number_of_cases:risk_adjusted_mortality_rate, as.numeric))
## # A tibble: 950 × 49
## facility_id hospital_name detailed_region region procedure
## <chr> <chr> <chr> <chr> <chr>
## 1 1 albany_medical_center capital_district capit… all_pci
## 2 116 arnot_ogden_med_ctr western_ny__rochest… weste… all_pci
## 3 746 bassett_medical_center capital_district capit… all_pci
## 4 1438 bellevue_hospital_ctr manhattan ny_me… all_pci
## 5 1178 bronxlebanon-concourse bronx ny_me… all_pci
## 6 1286 brookdale_univ_hosp_med_ctr kings ny_me… all_pci
## 7 885 brookhaven_memorial ny_metro__long_isla… ny_me… all_pci
## 8 207 buffalo_general_hosp western_ny__buffalo weste… all_pci
## 9 977 cayuga_med_ctr_ithaca central_ny centr… all_pci
## 10 636 crouse_hospital central_ny centr… all_pci
## # ℹ 940 more rows
## # ℹ 44 more variables: year_of_hospital_discharge <chr>, number_of_cases <dbl>,
## # number_of_deaths <dbl>, observed_mortality_rate <dbl>,
## # expected_mortality_rate <dbl>, risk_adjusted_mortality_rate <dbl>,
## # lower_limit_of_confidence_interval <chr>,
## # upper_limit_of_confidence_interval <chr>, comparison_results <chr>,
## # facility_name <chr>, short_description <chr>, description <chr>, …
What is the procedure with the highest observed mortality rate?
cardiac %>%
group_by(procedure) %>%
summarize(avg_mortality = mean(observed_mortality_rate)) %>%
arrange(-avg_mortality)
## # A tibble: 3 × 2
## procedure avg_mortality
## <chr> <dbl>
## 1 CABG 1.52
## 2 All PCI 1.22
## 3 Non-Emergency PCI 0.720
cardiac %>%
group_by(procedure) %>%
summarize(avg_mortality = mean(observed_mortality_rate)) %>%
ggplot(aes(x = reorder(procedure, avg_mortality), y = avg_mortality))+
geom_col(color = "black", fill = "lightblue")+
coord_flip()+
labs(title = "Average Observed Mortality Rate by Procedure",
x = "Procedure",
y = "Mortality Rate")+
theme_light(base_size = 12)
How has the mortality rate changed for cardiac surgery over time in each region?
#I'll come back to this later if I figure out the year stuff but feel free to take a crack at it :)
cardiac %>%
group_by(year_of_hospital_discharge) %>%
summarize(observed_mortality_rate=mean(observed_mortality_rate)) %>%
ggplot(aes(x =year_of_hospital_discharge, y = observed_mortality_rate))+
geom_col(color = "purple4", na.rm = T) + geom_smooth(method = lm, se= TRUE) +
labs(title = "Regional Cardiac Surgery Morality Rates",
x = "Year of Hospital Discharge",
y = "Mean Observed Mortality Rate")
## `geom_smooth()` using formula = 'y ~ x'
cardiac %>%
filter(hospital_name == "albany_med._ctr") %>%
group_by(year_of_hospital_discharge, hospital_name) %>%
summarize(avg_mortality = mean(observed_mortality_rate), .groups = 'keep') %>%
ggplot(aes(x = as.factor(year_of_hospital_discharge), y = avg_mortality, group = hospital_name))+
geom_line()+
geom_point()
How does the expected mortality rate compare to the observed mortality rate?
#I don't know which graph to plot for this one but if you can figure it out that would be great. I was thinking maybe scatter but I don't know for sure
#Expected mortality vs observed mortality
cardiac %>%
ggplot(aes(x = expected_mortality_rate, y = observed_mortality_rate))+
geom_point(color = "steelblue") + geom_smooth(method = lm, se= TRUE) +
labs(title = "Expected vs Observed Mortality Rate",
x = "Expected Mortality",
y = "Observed Mortality")
## `geom_smooth()` using formula = 'y ~ x'
Which region has the highest mortality rate?
cardiac %>%
group_by(region) %>%
summarize(avg_mortality = mean(observed_mortality_rate)) %>%
arrange(-avg_mortality)
## # A tibble: 7 × 2
## region avg_mortality
## <chr> <dbl>
## 1 Central NY 1.41
## 2 Western NY - Rochester 1.26
## 3 NY Metro - New Rochelle 1.12
## 4 Capital District 1.10
## 5 NY Metro - NYC 1.09
## 6 NY Metro - Long Island 0.935
## 7 Western NY - Buffalo 0.911
cardiac %>%
group_by(region) %>%
summarize(avg_mortality = mean(observed_mortality_rate)) %>%
ggplot(aes(x = reorder(region, avg_mortality), y = avg_mortality))+
geom_col(color = "black", fill = "lightpink")+
coord_flip()+
labs(title = "Average Observed Mortality Rate per Region",
x = "Region",
y = "Mortality Rate")+
theme_light(base_size = 12)
COMPARING NUMBER OF TOTAL PROCEDURES WITH AVERAGE MORTALITY RATE
total_cases <- cardiac %>%
group_by(facility_id) %>%
summarize(total_procedures = sum(number_of_cases), avg_mortality = mean(observed_mortality_rate)) %>%
ggplot(aes(x = total_procedures, y = avg_mortality))+
geom_point(color = "olivedrab") +
labs(title = "Average Mortality Rate compared with Procedure Numbers ",
x = "Total Number of Procedure",
y = "Mortality Rate")+
theme(axis.text.y = element_text(angle = 0, hjust = 1, size = 5))+
scale_x_log10()+geom_smooth(method=lm, se=F)
total_cases
## `geom_smooth()` using formula = 'y ~ x'
Map:
#Overall deaths for all years:
cardiac %>% #GET MAX LAT AND LON FROM CODE BELOW!!! EASY MAKES SENSE
select(facility_longitude, facility_latitude) %>%
summary()
## facility_longitude facility_latitude
## Min. :-78.87 Min. :40.58
## 1st Qu.:-74.92 1st Qu.:40.74
## Median :-73.95 Median :40.88
## Mean :-74.63 Mean :41.61
## 3rd Qu.:-73.80 3rd Qu.:42.73
## Max. :-72.98 Max. :44.70
## NA's :35 NA's :35
#All hospital map
ggmap(maptotal) +
geom_point(data = x, aes(facility_longitude, facility_latitude)) + labs(x= "Longitude", y= "Latitude", title="Cardiac Locations")
## Warning: Removed 4 rows containing missing values or values outside the scale range
## (`geom_point()`).
#For number of cases
ggmap(maptotal) +
geom_point(data = x, aes(facility_longitude, facility_latitude, colour = number_of_cases)) + #WE just add the chart in without using ggplot!
labs(x= "Longitude", y= "Latitude", title="Cardiac Locations")
## Warning: Removed 4 rows containing missing values or values outside the scale range
## (`geom_point()`).
#For mortality rate
ggmap(maptotal) +
geom_point(data = x, aes(facility_longitude, facility_latitude, colour = average_moratality_rate)) + #WE just add the chart in without using ggplot!
labs(x= "Longitude", y= "Latitude", title="Cardiac Locations")
## Warning: Removed 4 rows containing missing values or values outside the scale range
## (`geom_point()`).
#For total deaths
ggmap(maptotal) +
geom_point(data = x, aes(facility_longitude, facility_latitude, colour = total_deaths)) + #WE just add the chart in without using ggplot!
labs(x= "Longitude", y= "Latitude", title="Cardiac Locations")
## Warning: Removed 4 rows containing missing values or values outside the scale range
## (`geom_point()`).
#NYC Rate of mortaility
ggmap(mapnyc) +
geom_point(data = x, aes(facility_longitude, facility_latitude, colour = average_moratality_rate)) +
labs(x= "Longitude", y= "Latitude", title="Cardiac Locations") #colour??
## Warning: Removed 36 rows containing missing values or values outside the scale range
## (`geom_point()`).
#NYC Total Cases
ggmap(mapnyc) +
geom_point(data = x, aes(facility_longitude, facility_latitude, colour = number_of_cases)) +
labs(x= "Longitude", y= "Latitude", title="Cardiac Locations") #colour??
## Warning: Removed 36 rows containing missing values or values outside the scale range
## (`geom_point()`).
#NYC total deaths
ggmap(mapnyc) +
geom_point(data = x, aes(facility_longitude, facility_latitude, colour = total_deaths)) +
labs(x= "Longitude", y= "Latitude", title="Cardiac Locations") #colour??
## Warning: Removed 36 rows containing missing values or values outside the scale range
## (`geom_point()`).
cardiac %>%
group_by(procedure, hospital_name) %>%
summarize(procedure_cases = sum(number_of_cases), .groups = 'keep') %>%
ggplot(aes(x = procedure, y = procedure_cases))+
geom_col()
cardiac %>%
group_by(region, procedure) %>%
summarize(num_case = sum(number_of_cases), .groups = "keep") %>%
ggplot(aes_string(x="region", y = "num_case", fill = "procedure"))+
geom_col(position="dodge", alpha=0.8, color="black")+
labs(x=NULL, y=NULL, fill="Fill Variable")+theme(axis.text.x = element_text(angle=90,hjust = 1))
## Warning: `aes_string()` was deprecated in ggplot2 3.0.0.
## ℹ Please use tidy evaluation idioms with `aes()`.
## ℹ See also `vignette("ggplot2-in-packages")` for more information.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
cardiac %>%
group_by(region, year_of_hospital_discharge, procedure) %>%
summarize(num_case = sum(number_of_cases), .groups = "drop")
## # A tibble: 126 × 4
## region year_of_hospital_discharge procedure num_case
## <chr> <chr> <chr> <dbl>
## 1 Capital District 2010 All PCI 3667
## 2 Capital District 2010 CABG 970
## 3 Capital District 2010 Non-Emergency PCI 2850
## 4 Capital District 2011 All PCI 3690
## 5 Capital District 2011 CABG 848
## 6 Capital District 2011 Non-Emergency PCI 2859
## 7 Capital District 2012 All PCI 3257
## 8 Capital District 2012 CABG 897
## 9 Capital District 2012 Non-Emergency PCI 2372
## 10 Capital District 2013 All PCI 3286
## # ℹ 116 more rows
cardiac %>%
filter(facility_id!="0") %>%
group_by(hospital_name) %>%
summarise(mean_avg_rate=mean(observed_mortality_rate), total_cases_b=sum(number_of_cases)) %>%
arrange(-mean_avg_rate) %>%
mutate(total_deaths=mean_avg_rate/100*total_cases_b) %>%
arrange(-total_deaths)
## # A tibble: 81 × 4
## hospital_name mean_avg_rate total_cases_b total_deaths
## <chr> <dbl> <dbl> <dbl>
## 1 Mount Sinai Hospital 0.787 53499 421.
## 2 St. Francis Hospital 1.08 33785 366.
## 3 Rochester General Hosp 1.38 19930 276.
## 4 St. Josephs Hospital 1.11 24664 274.
## 5 Buffalo General Hosp 1.40 18684 262.
## 6 NYP-Columbia Presby. 0.996 21224 211.
## 7 Univ. Hosp-Stony Brook 1.23 16564 204.
## 8 North Shore Univ Hosp 0.916 21725 199.
## 9 Lenox Hill Hospital 0.853 22933 196.
## 10 Albany Medical Center 1.53 10503 161.
## # ℹ 71 more rows
scale_fill_discrete(labels = c(“Firmicutes_C” = “Firmicutes C”, “Firmicutes_A” = “Firmicutes A”, “Firmicutes_B” = “Firmicutes B”)) scale_x_discrete(labels = c(“case” = “diabetic”, “control” = “none diabetic”)) scale_shape_manual(values= c(16, 17), labels =c(“FALSE” = “negative”, “TRUE” = “positive”)) ## Shiny App
library(shiny)
library(shinydashboard)
##
## Attaching package: 'shinydashboard'
## The following object is masked from 'package:graphics':
##
## box
library(shinyjs)
##
## Attaching package: 'shinyjs'
## The following object is masked from 'package:shiny':
##
## runExample
## The following object is masked from 'package:lubridate':
##
## show
## The following objects are masked from 'package:methods':
##
## removeClass, show
library(ggplot2)
library(ggmap)
# UI Layout
ui <- dashboardPage(
skin = "purple",
# Header
dashboardHeader(
title = "Cardiac Dashboard",
titleWidth = 250
),
## Sidebar
dashboardSidebar(
sidebarMenu(
menuItem("Cases",
tabName = "cases",
icon = icon("folder-open")),
menuItem("Mortality Rate",
tabName = "dashboard",
icon = icon("skull")),
menuItem("Procedures",
tabName = "widgets",
icon = icon("stethoscope")),
menuItem("Maps",
tabName = "map",
icon = icon("earth-americas")),
menuItem("NYC Maps",
tabName = "nyc",
icon = icon("hotel"))
),
useShinyjs() # Activate shinyjs for dynamic control
),
## Body content
dashboardBody(
tags$head(
# Add custom styles for the app
tags$style(HTML("
.box {
border-radius: 8px;
box-shadow: 0 4px 8px rgba(0, 0, 0, 0.1);
}
.box-header {
background-color: #6a1b9a;
color: white;
border-radius: 8px 8px 0 0;
}
.box-body {
background-color: #f9f9f9;
}
.box-footer {
background-color: #e1bee7;
}
.selectize-input {
border-radius: 5px;
border: 1px solid #ddd;
}
.control-box {
margin-top: 20px;
}
"))
),
tabItems(
## Cases Tab
tabItem(tabName = "cases",
h1(strong("Cases Based on Cardiac Surgery in New York Hospitals"), style = "font-size:24px; text-align:center; margin-bottom: 20px;"),
fluidRow(
box(plotOutput("plot3a", height = 250), status = "primary", solidHeader = T, width = 6, title = "Cases per Year"),
box(title = "Controls", status = "info", solidHeader = T, width = 6,
selectInput("a", "Select Hospital:", choices = unique(cardiac$hospital_name))
)
),
fluidRow(
box(plotOutput("plot3b", height = 250), status = "primary", solidHeader = T, width = 6, title = "Cases vs Mortality Rate"),
box(title = "Controls", status = "info", solidHeader = T, width = 6,
selectInput("b", "Select Year:", choices = unique(cardiac$year_of_hospital_discharge))
)
)
),
## Mortality Rate Tab
tabItem(tabName = "dashboard",
h1(strong("Mortality Rate Analysis Based on Cardiac Surgery Results"), style = "font-size:24px; text-align:center; margin-bottom: 20px;"),
fluidRow(
box(plotOutput("plot1a", height = 250), status = "primary", solidHeader = T, width = 6, title = "Mortality Rate by Region"),
box(title = "Controls", status = "info", solidHeader = T, width = 6,
selectInput("region", "Select Region:", choices = unique(cardiac$region))
)
),
fluidRow(
box(plotOutput("plot1b", height = 250), status = "primary", solidHeader = T, width = 6, title = "Mortality Rate by Year"),
box(title = "Controls", status = "info", solidHeader = T, width = 6,
selectInput("year", "Select Year:", choices = unique(cardiac$year_of_hospital_discharge))
)
),
fluidRow(
box(plotOutput("plot1c", height = 250), status = "primary", solidHeader = T, width = 6, title = "Mortality Rate Over Time"),
box(title = "Controls", status = "info", solidHeader = T, width = 6,
selectInput("hospital", "Select Hospital:", choices = unique(cardiac$hospital_name))
)
)
),
## Procedures Tab
tabItem(tabName = "widgets",
h1(strong("Procedure Analysis in New York Hospitals"), style = "font-size:24px; text-align:center; margin-bottom: 20px;"),
fluidRow(
box(plotOutput("plot2a", height = 250), status = "primary", solidHeader = T, width = 6, title = "Procedures by X Axis"),
box(title = "Controls", status = "info", solidHeader = T, width = 6,
radioButtons("x", "Select X Axis:", choices = c("year_of_hospital_discharge", "region"), selected = "year_of_hospital_discharge")
)
),
fluidRow(
box(plotOutput("plot2b", height = 250), status = "primary", solidHeader = T, width = 6, title = "Mortality Rate by Procedure"),
box(title = "Controls", status = "info", solidHeader = T, width = 6,
selectInput("p", "Select Year:", choices = unique(cardiac$year_of_hospital_discharge))
)
),
fluidRow(
box(plotOutput("plot2c", height = 250), status = "primary", solidHeader = T, width = 6, title = "Procedure Cases per Hospital"),
box(title = "Controls", status = "info", solidHeader = T, width = 6,
selectInput("h", "Select Hospital:", choices = unique(cardiac$hospital_name))
)
)
),
## Maps Tab
tabItem(tabName = "map",
h1(strong("Overall Maps Based on Dataset"), style = "font-size:24px; text-align:center; margin-bottom: 20px;"),
fluidRow(
box(plotOutput("plot4a", height = 450), status = "primary", solidHeader = T, width = 6, title = "Map 1"),
box(plotOutput("plot4b", height = 450), status = "primary", solidHeader = T, width = 6, title = "Map 2")
),
fluidRow(
box(plotOutput("plot4c", height = 450), status = "primary", solidHeader = T, width = 6, title = "Map 3"),
box(plotOutput("plot4d", height = 450), status = "primary", solidHeader = T, width = 6, title = "Map 4")
)
),
## NYC Maps Tab
tabItem(tabName = "nyc",
h1(strong("Maps Zoomed in on New York City"), style = "font-size:24px; text-align:center; margin-bottom: 20px;"),
fluidRow(
box(plotOutput("plot5a", height = 450), status = "primary", solidHeader = T, width = 6, title = "NYC Map 1"),
box(plotOutput("plot5b", height = 450), status = "primary", solidHeader = T, width = 6, title = "NYC Map 2")
),
fluidRow(
box(plotOutput("plot5c", height = 450), status = "primary", solidHeader = T, width = 6, title = "NYC Map 3")
)
)
)
)
)
# Server Function
server <- function(input, output, session) {
session$onSessionEnded(stopApp)
output$plot1a <- renderPlot({
cardiac %>%
filter(region == input$region) %>%
ggplot(aes(x = observed_mortality_rate))+
geom_density(color = "black", fill = "steelblue", alpha = 0.6)+
labs(title = "Observed Mortality Rate Distribution by Region",
x = "Mortality Rate",
y = "Proportion of Hospitals in the Region")
})
output$plot1b <- renderPlot({
cardiac %>%
filter(year_of_hospital_discharge == input$year) %>%
ggplot(aes(x = observed_mortality_rate))+
geom_density(color = "black", fill = "steelblue", alpha = 0.6)+
labs(title = "Observed Mortality Rate Distribution by Year",
x = "Mortality Rate",
y = "Proportion of Hospitals")
})
output$plot1c <- renderPlot({
cardiac %>%
filter(hospital_name == input$hospital) %>%
group_by(year_of_hospital_discharge, hospital_name) %>%
summarize(avg_mortality = mean(observed_mortality_rate), .groups = 'keep') %>%
ggplot(aes(x = as.factor(year_of_hospital_discharge), y = avg_mortality, group = hospital_name))+
geom_line()+
geom_point(na.rm = T)+
labs(title = "Mortality Rate Over Time",
x = "Year",
y = "Mortality Rate")
})
output$plot2a <- renderPlot({ #this is a bigger picture of the two plots shown below
cardiac %>%
ggplot(aes_string(x= input$x, fill = "procedure"))+
geom_bar(position="dodge", alpha=0.8, color="black")+
coord_flip()+
labs(x= NULL, y=NULL, fill= "Procedure")
})
output$plot2b <- renderPlot({
cardiac %>%
filter(year_of_hospital_discharge == input$p) %>%
group_by(procedure) %>%
summarize(avg_mortality = mean(observed_mortality_rate)) %>%
ggplot(aes(x = reorder(procedure, avg_mortality), y = avg_mortality))+
geom_col(color = "black", fill = "lightblue")+
coord_flip()+
labs(title = "Average Observed Mortality Rate by Procedure",
x = "Procedure",
y = "Mortality Rate")+
theme_light(base_size = 14)
})
output$plot2c <- renderPlot({
cardiac %>%
filter(hospital_name == input$h) %>%
group_by(procedure, hospital_name) %>%
summarize(procedure_cases = sum(number_of_cases), .groups = 'keep') %>%
ggplot(aes(x = procedure, y = procedure_cases))+
geom_col(color = "black", fill = "lightblue")+
labs(title = "Number of Cases per Procedure",
x = "Procedure",
y = "Number of Cases")+
theme_light(base_size = 14)
})
output$plot3a <- renderPlot({
cardiac %>%
filter(hospital_name == input$a) %>%
group_by(year_of_hospital_discharge) %>%
summarize(total_cases_a = sum(number_of_cases)) %>%
ggplot(aes_string(x="year_of_hospital_discharge", y = "total_cases_a"))+
geom_col(alpha=0.8, color="black", fill = "steelblue")+
labs(title = "Number of Cases per Year",
x= "Year",
y= "Number of Cases")+
theme_light(base_size = 14)
})
output$plot3b <- renderPlot({
cardiac %>%
filter(year_of_hospital_discharge == input$b) %>%
group_by(facility_id, procedure) %>%
summarize(total_procedures = sum(number_of_cases), avg_mortality = mean(observed_mortality_rate)) %>%
ggplot(aes(x = total_procedures, y = avg_mortality))+
geom_point(color = "olivedrab", na.rm = T) +
labs(title = "Average Mortality Rate compared with Procedure Numbers ",
x = "Total Number of Procedures",
y = "Mortality Rate")+
theme(axis.text.y = element_text(angle = 0, hjust = 1, size = 5))+
theme_classic()+
scale_x_log10()+
geom_smooth(method=lm, se=F, formula = 'y ~ x')
})
output$plot4a <- renderPlot({
ggmap(maptotal) +
geom_point(data = x, aes(facility_longitude, facility_latitude, size = 1.5), na.rm= T) + labs(x= "Longitude", y= "Latitude", title="Cardiac Locations")
})
output$plot4b <- renderPlot({
ggmap(maptotal) +
geom_point(data = x, aes(facility_longitude, facility_latitude, colour = number_of_cases, size = 1.5), na.rm= T) + #WE just add the chart in without using ggplot!
labs(x= "Longitude", y= "Latitude", title="Cardiac Locations")
})
output$plot4c <- renderPlot({
ggmap(maptotal) +
geom_point(data = x, aes(facility_longitude, facility_latitude, colour = average_moratality_rate, size = 1.5), na.rm= T) + #WE just add the chart in without using ggplot!
labs(x= "Longitude", y= "Latitude", title="Cardiac Locations")
})
output$plot4d <- renderPlot({
ggmap(maptotal) +
geom_point(data = x, aes(facility_longitude, facility_latitude, colour = total_deaths, size = 1.5), na.rm= T) + #WE just add the chart in without using ggplot!
labs(x= "Longitude", y= "Latitude", title="Cardiac Locations")
})
output$plot5a <- renderPlot({
ggmap(mapnyc) +
geom_point(data = x, aes(facility_longitude, facility_latitude, colour = average_moratality_rate,size = 2.5), na.rm= T) +
labs(x= "Longitude", y= "Latitude", title="Cardiac Locations")
})
output$plot5b <- renderPlot({
ggmap(mapnyc) +
geom_point(data = x, aes(facility_longitude, facility_latitude, colour = number_of_cases, size = 2.5), na.rm= T) +
labs(x= "Longitude", y= "Latitude", title="Cardiac Locations")
})
output$plot5c <- renderPlot({
ggmap(mapnyc) +
geom_point(data = x, aes(facility_longitude, facility_latitude, colour = total_deaths, size = 2.5), na.rm= T) +
labs(x= "Longitude", y= "Latitude", title="Cardiac Locations")
})
}
# Run the app
shinyApp(ui, server)
library(shiny)
library(shinydashboard)
library(shinyjs)
library(ggplot2)
library(ggmap)
# UI Layout
ui <- dashboardPage(
skin = "blue",
# Header
dashboardHeader(
title = "Cardiac Dashboard",
titleWidth = 250
),
## Sidebar
dashboardSidebar(
sidebarMenu(
menuItem("Mortality Rate",
tabName = "dashboard",
icon = icon("skull")),
menuItem("Procedures",
tabName = "widgets",
icon = icon("stethoscope")),
menuItem("Cases",
tabName = "cases",
icon = icon("folder-open")),
menuItem("Maps",
tabName = "map",
icon = icon("earth-americas")),
menuItem("NYC Maps",
tabName = "nyc",
icon = icon("hotel"))
),
useShinyjs() # Activate shinyjs for dynamic control
),
## Body content
dashboardBody(
tags$head(
# Add custom styles for the app
tags$style(HTML("
.box {
border-radius: 8px;
box-shadow: 0 4px 8px rgba(0, 0, 0, 0.1);
}
.box-header {
background-color: #6a1b9a;
color: white;
border-radius: 8px 8px 0 0;
}
.box-body {
background-color: #f9f9f9;
}
.box-footer {
background-color: #e1bee7;
}
.selectize-input {
border-radius: 5px;
border: 1px solid #ddd;
}
.control-box {
margin-top: 20px;
}
"))
),
tabItems(
## Mortality Rate Tab
tabItem(tabName = "dashboard",
h1(strong("Mortality Rate Analysis Based on Cardiac Surgery Results"), style = "font-size:24px; text-align:center; margin-bottom: 20px;"),
fluidRow(
box(plotOutput("plot1a", height = 250), status = "primary", solidHeader = T, width = 6, title = "Mortality Rate by Region"),
box(title = "Controls", status = "info", solidHeader = T, width = 6,
selectInput("region", "Select Region:", choices = unique(cardiac$region))
)
),
fluidRow(
box(plotOutput("plot1b", height = 250), status = "primary", solidHeader = T, width = 6, title = "Mortality Rate by Year"),
box(title = "Controls", status = "info", solidHeader = T, width = 6,
selectInput("year", "Select Year:", choices = unique(cardiac$year_of_hospital_discharge))
)
),
fluidRow(
box(plotOutput("plot1c", height = 250), status = "primary", solidHeader = T, width = 6, title = "Mortality Rate Over Time"),
box(title = "Controls", status = "info", solidHeader = T, width = 6,
selectInput("hospital", "Select Hospital:", choices = unique(cardiac$hospital_name))
)
)
),
## Procedures Tab
tabItem(tabName = "widgets",
h1(strong("Procedure Analysis in New York Hospitals"), style = "font-size:24px; text-align:center; margin-bottom: 20px;"),
fluidRow(
box(plotOutput("plot2a", height = 250), status = "primary", solidHeader = T, width = 6, title = "Procedures by X Axis"),
box(title = "Controls", status = "info", solidHeader = T, width = 6,
radioButtons("x", "Select X Axis:", choices = c("year_of_hospital_discharge", "region"), selected = "year_of_hospital_discharge")
)
),
fluidRow(
box(plotOutput("plot2b", height = 250), status = "primary", solidHeader = T, width = 6, title = "Mortality Rate by Procedure"),
box(title = "Controls", status = "info", solidHeader = T, width = 6,
selectInput("p", "Select Year:", choices = unique(cardiac$year_of_hospital_discharge))
)
),
fluidRow(
box(plotOutput("plot2c", height = 250), status = "primary", solidHeader = T, width = 6, title = "Procedure Cases per Hospital"),
box(title = "Controls", status = "info", solidHeader = T, width = 6,
selectInput("h", "Select Hospital:", choices = unique(cardiac$hospital_name))
)
)
),
## Cases Tab
tabItem(tabName = "cases",
h1(strong("Cases Based on Cardiac Surgery in New York Hospitals"), style = "font-size:24px; text-align:center; margin-bottom: 20px;"),
fluidRow(
box(plotOutput("plot3a", height = 250), status = "primary", solidHeader = T, width = 6, title = "Cases per Year"),
box(title = "Controls", status = "info", solidHeader = T, width = 6,
selectInput("a", "Select Hospital:", choices = unique(cardiac$hospital_name))
)
),
fluidRow(
box(plotOutput("plot3b", height = 250), status = "primary", solidHeader = T, width = 6, title = "Cases vs Mortality Rate"),
box(title = "Controls", status = "info", solidHeader = T, width = 6,
selectInput("b", "Select Year:", choices = unique(cardiac$year_of_hospital_discharge))
)
)
),
## Maps Tab
tabItem(tabName = "map",
h1(strong("Overall Maps Based on Dataset"), style = "font-size:24px; text-align:center; margin-bottom: 20px;"),
fluidRow(
box(plotOutput("plot4a", height = 450), status = "primary", solidHeader = T, width = 6, title = "Map 1"),
box(plotOutput("plot4b", height = 450), status = "primary", solidHeader = T, width = 6, title = "Map 2")
),
fluidRow(
box(plotOutput("plot4c", height = 450), status = "primary", solidHeader = T, width = 6, title = "Map 3"),
box(plotOutput("plot4d", height = 450), status = "primary", solidHeader = T, width = 6, title = "Map 4")
)
),
## NYC Maps Tab
tabItem(tabName = "nyc",
h1(strong("Maps Zoomed in on New York City"), style = "font-size:24px; text-align:center; margin-bottom: 20px;"),
fluidRow(
box(plotOutput("plot5a", height = 450), status = "primary", solidHeader = T, width = 6, title = "NYC Map 1"),
box(plotOutput("plot5b", height = 450), status = "primary", solidHeader = T, width = 6, title = "NYC Map 2")
),
fluidRow(
box(plotOutput("plot5c", height = 450), status = "primary", solidHeader = T, width = 6, title = "NYC Map 3")
)
)
)
)
)
# Server Function
server <- function(input, output, session) {
session$onSessionEnded(stopApp)
output$plot1a <- renderPlot({
cardiac %>%
filter(region == input$region) %>%
ggplot(aes(x = observed_mortality_rate))+
geom_density(color = "black", fill = "steelblue", alpha = 0.6)+
labs(title = "Observed Mortality Rate Distribution by Region",
x = "Mortality Rate",
y = "Proportion of Hospitals in the Region")
})
output$plot1b <- renderPlot({
cardiac %>%
filter(year_of_hospital_discharge == input$year) %>%
ggplot(aes(x = observed_mortality_rate))+
geom_density(color = "black", fill = "steelblue", alpha = 0.6)+
labs(title = "Observed Mortality Rate Distribution by Year",
x = "Mortality Rate",
y = "Proportion of Hospitals")
})
output$plot1c <- renderPlot({
cardiac %>%
filter(hospital_name == input$hospital) %>%
group_by(year_of_hospital_discharge, hospital_name) %>%
summarize(avg_mortality = mean(observed_mortality_rate), .groups = 'keep') %>%
ggplot(aes(x = as.factor(year_of_hospital_discharge), y = avg_mortality, group = hospital_name))+
geom_line()+
geom_point(na.rm = T)+
labs(title = "Mortality Rate Over Time",
x = "Year",
y = "Mortality Rate")
})
output$plot2a <- renderPlot({ #this is a bigger picture of the two plots shown below
cardiac %>%
ggplot(aes_string(x= input$x, fill = "procedure"))+
geom_bar(position="dodge", alpha=0.8, color="black")+
coord_flip() +
labs(x= "Procedure Type", y= "New York Region", fill= "Procedure")
})
output$plot2b <- renderPlot({
cardiac %>%
filter(year_of_hospital_discharge == input$p) %>%
group_by(procedure) %>%
summarize(avg_mortality = mean(observed_mortality_rate)) %>%
ggplot(aes(x = reorder(procedure, avg_mortality), y = avg_mortality))+
geom_col(color = "black", fill = "lightblue")+
coord_flip()+
labs(title = "Average Observed Mortality Rate by Procedure",
x = "Procedure",
y = "Mortality Rate")+
theme_light(base_size = 14)
})
output$plot2c <- renderPlot({
cardiac %>%
filter(hospital_name == input$h) %>%
group_by(procedure, hospital_name) %>%
summarize(procedure_cases = sum(number_of_cases), .groups = 'keep') %>%
ggplot(aes(x = procedure, y = procedure_cases))+
geom_col(color = "black", fill = "lightblue")+
coord_flip() +
labs(title = "Number of Cases per Procedure",
x = "Procedure",
y = "Number of Cases")+
theme_light(base_size = 14)
})
output$plot3a <- renderPlot({
cardiac %>%
filter(hospital_name == input$a) %>%
group_by(year_of_hospital_discharge) %>%
summarize(total_cases_a = sum(number_of_cases)) %>%
ggplot(aes_string(x="year_of_hospital_discharge", y = "total_cases_a"))+
geom_col(alpha=0.8, color="black", fill = "steelblue")+
labs(title = "Number of Cases per Year",
x= "Year",
y= "Number of Cases")+
theme_light(base_size = 14)
})
output$plot3b <- renderPlot({
cardiac %>%
filter(year_of_hospital_discharge == input$b) %>%
group_by(facility_id, procedure) %>%
summarize(total_procedures = sum(number_of_cases), avg_mortality = mean(observed_mortality_rate)) %>%
ggplot(aes(x = total_procedures, y = avg_mortality))+
geom_point(color = "olivedrab", na.rm = T) +
labs(title = "Average Mortality Rate compared with Procedure Numbers ",
x = "Total Number of Procedures",
y = "Mortality Rate")+
theme(axis.text.y = element_text(angle = 0, hjust = 1, size = 5))+
theme_classic()+
scale_x_log10()+
geom_smooth(method=lm, se=F, formula = 'y ~ x')
})
output$plot4a <- renderPlot({
ggmap(maptotal) +
geom_point(data = x, aes(facility_longitude, facility_latitude, size = 1.5), na.rm= T) + labs(x= "Longitude", y= "Latitude", title="Cardiac Locations")
})
output$plot4a <- renderPlot({
ggmap(maptotal) +
geom_point(data = x, aes(facility_longitude, facility_latitude, size = 2, color = average_moratality_rate), alpha = 0.8) +
scale_color_gradient(low = "steelblue", high = "midnightblue") +
labs(x= "Longitude", y= "Latitude", title="Cardiac Locations")
})
output$plot4b <- renderPlot({
ggmap(maptotal) +
geom_point(data = x, aes(facility_longitude, facility_latitude, color = number_of_cases, size = 2), alpha = 0.8) +
scale_color_gradient(low = "steelblue", high = "midnightblue") +
labs(x= "Longitude", y= "Latitude", title="Cases Distribution")
})
output$plot4c <- renderPlot({
ggmap(maptotal) +
geom_point(data = x, aes(facility_longitude, facility_latitude, color = average_moratality_rate, size = 2), alpha = 0.8) +
scale_color_gradient(low = "steelblue", high = "midnightblue") +
labs(x= "Longitude", y= "Latitude", title="Mortality Rate")
})
output$plot4d <- renderPlot({
ggmap(maptotal) +
geom_point(data = x, aes(facility_longitude, facility_latitude, color = total_deaths, size = 2), alpha = 0.8) +
scale_color_gradient(low = "steelblue", high = "midnightblue") +
labs(x= "Longitude", y= "Latitude", title="Total Deaths")
})
output$plot5a <- renderPlot({
ggmap(mapnyc) +
geom_point(data = x, aes(facility_longitude, facility_latitude, colour = average_moratality_rate,size = 2.5), na.rm= T) + scale_color_gradient(low = "steelblue", high = "midnightblue") +
labs(x= "Longitude", y= "Latitude", title="Average Mortality Rate by Hospital")
})
output$plot5b <- renderPlot({
ggmap(mapnyc) +
geom_point(data = x, aes(facility_longitude, facility_latitude, colour = number_of_cases, size = 2.5), na.rm= T) +
scale_color_gradient(low = "steelblue", high = "midnightblue") +
labs(x= "Longitude", y= "Latitude", title="Total Number of Cases")
})
output$plot5c <- renderPlot({
ggmap(mapnyc) +
geom_point(data = x, aes(facility_longitude, facility_latitude, colour = total_deaths, size = 2.5), na.rm= T) +
scale_color_gradient(low = "steelblue", high = "midnightblue") +
labs(x= "Longitude", y= "Latitude", title="Total Number of Deaths")
})
}
# Run the app
shinyApp(ui, server)
library(shiny)
library(shinydashboard)
library(shinyjs)
library(ggplot2)
library(ggmap)
# UI Layout
ui <- dashboardPage(
skin = "blue",
# Header
dashboardHeader(
title = "Cardiac Dashboard",
titleWidth = 250
),
## Sidebar
dashboardSidebar(
sidebarMenu(
menuItem("Mortality Rate",
tabName = "dashboard",
icon = icon("skull")),
menuItem("Procedures",
tabName = "widgets",
icon = icon("stethoscope")),
menuItem("Cases",
tabName = "cases",
icon = icon("folder-open")),
menuItem("Maps",
tabName = "map",
icon = icon("earth-americas")),
menuItem("NYC Maps",
tabName = "nyc",
icon = icon("hotel"))
),
useShinyjs() # Activate shinyjs for dynamic control
),
## Body content
dashboardBody(
tags$head(
# Add custom styles for the app
tags$style(HTML("
.box {
border-radius: 8px;
box-shadow: 0 4px 8px rgba(0, 0, 0, 0.1);
}
.box-header {
background-color: #6a1b9a;
color: white;
border-radius: 8px 8px 0 0;
}
.box-body {
background-color: #f9f9f9;
}
.box-footer {
background-color: #e1bee7;
}
.selectize-input {
border-radius: 5px;
border: 1px solid #ddd;
}
.control-box {
margin-top: 20px;
}
"))
),
tabItems(
## Mortality Rate Tab
tabItem(tabName = "dashboard",
h1(strong("Mortality Rate Analysis Based on Cardiac Surgery Results"), style = "font-size:24px; text-align:center; margin-bottom: 20px;"),
fluidRow(
box(plotOutput("plot1a", height = 250), status = "primary", solidHeader = T, width = 6, title = "Mortality Rate by Region"),
box(title = "Controls", status = "info", solidHeader = T, width = 6,
selectInput("region", "Select Region:", choices = unique(year_data$region))
)
),
fluidRow(
box(plotOutput("plot1b", height = 250), status = "primary", solidHeader = T, width = 6, title = "Mortality Rate by Year"),
box(title = "Controls", status = "info", solidHeader = T, width = 6,
selectInput("year", "Select Year:", choices = unique(year_data$year_of_hospital_discharge))
)
),
fluidRow(
box(plotOutput("plot1c", height = 250), status = "primary", solidHeader = T, width = 6, title = "Mortality Rate Over Time"),
box(title = "Controls", status = "info", solidHeader = T, width = 6,
selectInput("hospital", "Select Hospital:", choices = unique(year_data$hospital_name))
)
)
),
## Procedures Tab
tabItem(tabName = "widgets",
h1(strong("Procedure Analysis in New York Hospitals"), style = "font-size:24px; text-align:center; margin-bottom: 20px;"),
fluidRow(
box(plotOutput("plot2a", height = 250), status = "primary", solidHeader = T, width = 6, title = "Procedures by X Axis"),
box(title = "Controls", status = "info", solidHeader = T, width = 6,
radioButtons("x", "Select X Axis:", choices = c("year_of_hospital_discharge", "region"), selected = "year_of_hospital_discharge")
)
),
fluidRow(
box(plotOutput("plot2b", height = 250), status = "primary", solidHeader = T, width = 6, title = "Mortality Rate by Procedure"),
box(title = "Controls", status = "info", solidHeader = T, width = 6,
selectInput("p", "Select Year:", choices = unique(year_data$year_of_hospital_discharge))
)
),
fluidRow(
box(plotOutput("plot2c", height = 250), status = "primary", solidHeader = T, width = 6, title = "Procedure Cases per Hospital"),
box(title = "Controls", status = "info", solidHeader = T, width = 6,
selectInput("h", "Select Hospital:", choices = unique(year_data$hospital_name))
)
)
),
## Cases Tab
tabItem(tabName = "cases",
h1(strong("Cases Based on Cardiac Surgery in New York Hospitals"), style = "font-size:24px; text-align:center; margin-bottom: 20px;"),
fluidRow(
box(plotOutput("plot3a", height = 250), status = "primary", solidHeader = T, width = 6, title = "Cases per Year"),
box(title = "Controls", status = "info", solidHeader = T, width = 6,
selectInput("a", "Select Hospital:", choices = unique(year_data$hospital_name))
)
),
fluidRow(
box(plotOutput("plot3b", height = 250), status = "primary", solidHeader = T, width = 6, title = "Cases vs Mortality Rate"),
box(title = "Controls", status = "info", solidHeader = T, width = 6,
selectInput("b", "Select Year:", choices = unique(year_data$year_of_hospital_discharge))
)
)
),
## Maps Tab
tabItem(tabName = "map",
h1(strong("Overall Maps Based on Dataset"), style = "font-size:24px; text-align:center; margin-bottom: 20px;"),
fluidRow(
box(plotOutput("plot4a", height = 450), status = "primary", solidHeader = T, width = 6, title = "Map 1"),
box(plotOutput("plot4b", height = 450), status = "primary", solidHeader = T, width = 6, title = "Map 2")
),
fluidRow(
box(plotOutput("plot4c", height = 450), status = "primary", solidHeader = T, width = 6, title = "Map 3"),
box(plotOutput("plot4d", height = 450), status = "primary", solidHeader = T, width = 6, title = "Map 4")
)
),
## NYC Maps Tab
tabItem(tabName = "nyc",
h1(strong("Maps Zoomed in on New York City"), style = "font-size:24px; text-align:center; margin-bottom: 20px;"),
fluidRow(
box(plotOutput("plot5a", height = 450), status = "primary", solidHeader = T, width = 6, title = "NYC Map 1"),
box(plotOutput("plot5b", height = 450), status = "primary", solidHeader = T, width = 6, title = "NYC Map 2")
),
fluidRow(
box(plotOutput("plot5c", height = 450), status = "primary", solidHeader = T, width = 6, title = "NYC Map 3")
)
)
)
)
)
# Server Function
server <- function(input, output, session) {
session$onSessionEnded(stopApp)
output$plot1a <- renderPlot({
year_data %>%
filter(region == input$region) %>%
ggplot(aes(x = observed_mortality_rate))+
geom_density(color = "black", fill = "steelblue", alpha = 0.6)+
labs(title = "Observed Mortality Rate Distribution by Region",
x = "Mortality Rate",
y = "Proportion of Hospitals in the Region")
})
output$plot1b <- renderPlot({
year_data %>%
filter(year_of_hospital_discharge == input$year) %>%
ggplot(aes(x = observed_mortality_rate))+
geom_density(color = "black", fill = "steelblue", alpha = 0.6)+
labs(title = "Observed Mortality Rate Distribution by Year",
x = "Mortality Rate",
y = "Proportion of Hospitals")
})
output$plot1c <- renderPlot({
year_data %>%
filter(hospital_name == input$hospital) %>%
group_by(year_of_hospital_discharge, hospital_name) %>%
summarize(avg_mortality = mean(observed_mortality_rate), .groups = 'keep') %>%
ggplot(aes(x = as.factor(year_of_hospital_discharge), y = avg_mortality, group = hospital_name))+
geom_line()+
geom_point(na.rm = T)+
labs(title = "Mortality Rate Over Time",
x = "Year",
y = "Mortality Rate")
})
output$plot2a <- renderPlot({ #this is a bigger picture of the two plots shown below
year_data %>%
ggplot(aes_string(x= input$x, fill = "procedure"))+
geom_bar(position="dodge", alpha=0.8, color="black")+
coord_flip() +
labs(x= "Procedure Type", y= "New York Region", fill= "Procedure")
})
output$plot2b <- renderPlot({
year_data %>%
filter(year_of_hospital_discharge == input$p) %>%
group_by(procedure) %>%
summarize(avg_mortality = mean(observed_mortality_rate)) %>%
ggplot(aes(x = reorder(procedure, avg_mortality), y = avg_mortality))+
geom_col(color = "black", fill = "lightblue")+
coord_flip()+
labs(title = "Average Observed Mortality Rate by Procedure",
x = "Procedure",
y = "Mortality Rate")+
theme_light(base_size = 14)
})
output$plot2c <- renderPlot({
year_data %>%
filter(hospital_name == input$h) %>%
group_by(procedure, hospital_name) %>%
summarize(procedure_cases = sum(number_of_cases), .groups = 'keep') %>%
ggplot(aes(x = procedure, y = procedure_cases))+
geom_col(color = "black", fill = "lightblue")+
coord_flip() +
labs(title = "Number of Cases per Procedure",
x = "Procedure",
y = "Number of Cases")+
theme_light(base_size = 14)
})
output$plot3a <- renderPlot({
year_data %>%
filter(hospital_name == input$a) %>%
group_by(year_of_hospital_discharge) %>%
summarize(total_cases_a = sum(number_of_cases)) %>%
ggplot(aes_string(x="year_of_hospital_discharge", y = "total_cases_a"))+
geom_col(alpha=0.8, color="black", fill = "steelblue")+
labs(title = "Number of Cases per Year",
x= "Year",
y= "Number of Cases")+
theme_light(base_size = 14)
})
output$plot3b <- renderPlot({
year_data %>%
filter(year_of_hospital_discharge == input$b) %>%
group_by(facility_id, procedure) %>%
summarize(total_procedures = sum(number_of_cases), avg_mortality = mean(observed_mortality_rate)) %>%
ggplot(aes(x = total_procedures, y = avg_mortality))+
geom_point(color = "olivedrab", na.rm = T) +
labs(title = "Average Mortality Rate compared with Procedure Numbers ",
x = "Total Number of Procedures",
y = "Mortality Rate")+
theme(axis.text.y = element_text(angle = 0, hjust = 1, size = 5))+
theme_classic()+
scale_x_log10()+
geom_smooth(method=lm, se=F, formula = 'y ~ x')
})
output$plot4a <- renderPlot({
ggmap(maptotal) +
geom_point(data = x, aes(facility_longitude, facility_latitude, size = 1.5), na.rm= T) + labs(x= "Longitude", y= "Latitude", title="Cardiac Locations")
})
output$plot4a <- renderPlot({
ggmap(maptotal) +
geom_point(data = x, aes(facility_longitude, facility_latitude, size = 2, color = average_moratality_rate), alpha = 0.8) +
scale_color_gradient(low = "steelblue", high = "midnightblue") +
labs(x= "Longitude", y= "Latitude", title="Cardiac Locations")
})
output$plot4b <- renderPlot({
ggmap(maptotal) +
geom_point(data = x, aes(facility_longitude, facility_latitude, color = number_of_cases, size = 2), alpha = 0.8) +
scale_color_gradient(low = "steelblue", high = "midnightblue") +
labs(x= "Longitude", y= "Latitude", title="Cases Distribution")
})
output$plot4c <- renderPlot({
ggmap(maptotal) +
geom_point(data = x, aes(facility_longitude, facility_latitude, color = average_moratality_rate, size = 2), alpha = 0.8) +
scale_color_gradient(low = "steelblue", high = "midnightblue") +
labs(x= "Longitude", y= "Latitude", title="Mortality Rate")
})
output$plot4d <- renderPlot({
ggmap(maptotal) +
geom_point(data = x, aes(facility_longitude, facility_latitude, color = total_deaths, size = 2), alpha = 0.8) +
scale_color_gradient(low = "steelblue", high = "midnightblue") +
labs(x= "Longitude", y= "Latitude", title="Total Deaths")
})
output$plot5a <- renderPlot({
ggmap(mapnyc) +
geom_point(data = x, aes(facility_longitude, facility_latitude, colour = average_moratality_rate,size = 2.5), na.rm= T) + scale_color_gradient(low = "steelblue", high = "midnightblue") +
labs(x= "Longitude", y= "Latitude", title="Average Mortality Rate by Hospital")
})
output$plot5b <- renderPlot({
ggmap(mapnyc) +
geom_point(data = x, aes(facility_longitude, facility_latitude, colour = number_of_cases, size = 2.5), na.rm= T) +
scale_color_gradient(low = "steelblue", high = "midnightblue") +
labs(x= "Longitude", y= "Latitude", title="Total Number of Cases")
})
output$plot5c <- renderPlot({
ggmap(mapnyc) +
geom_point(data = x, aes(facility_longitude, facility_latitude, colour = total_deaths, size = 2.5), na.rm= T) +
scale_color_gradient(low = "steelblue", high = "midnightblue") +
labs(x= "Longitude", y= "Latitude", title="Total Number of Deaths")
})
}
# Run the app
shinyApp(ui, server)
library(shiny)
library(shinydashboard)
library(shinyjs)
library(ggplot2)
library(ggmap)
# UI Layout
ui <- dashboardPage(
skin = "blue",
# Header
dashboardHeader(
title = "Cardiac Dashboard",
titleWidth = 250
),
## Sidebar
dashboardSidebar(
sidebarMenu(
menuItem("Mortality Rate",
tabName = "dashboard",
icon = icon("skull")),
menuItem("Procedures",
tabName = "widgets",
icon = icon("stethoscope")),
menuItem("Cases",
tabName = "cases",
icon = icon("folder-open")),
menuItem("Maps",
tabName = "map",
icon = icon("earth-americas")),
menuItem("NYC Maps",
tabName = "nyc",
icon = icon("hotel"))
),
useShinyjs() # Activate shinyjs for dynamic control
),
## Body content
dashboardBody(
tags$head(
# Add custom styles for the app
tags$style(HTML("
.box {
border-radius: 8px;
box-shadow: 0 4px 8px rgba(0, 0, 0, 0.1);
}
.box-header {
background-color: #6a1b9a;
color: white;
border-radius: 8px 8px 0 0;
}
.box-body {
background-color: #f9f9f9;
}
.box-footer {
background-color: #e1bee7;
}
.selectize-input {
border-radius: 5px;
border: 1px solid #ddd;
}
.control-box {
margin-top: 20px;
}
"))
),
tabItems(
## Mortality Rate Tab
tabItem(tabName = "dashboard",
h1(strong("Mortality Rate Analysis Based on Cardiac Surgery Results"), style = "font-size:24px; text-align:center; margin-bottom: 20px;"),
fluidRow(
box(plotOutput("plot1a", height = 250), status = "primary", solidHeader = T, width = 6, title = "Mortality Rate by Region"),
box(title = "Controls", status = "info", solidHeader = T, width = 6,
selectInput("region", "Select Region:", choices = unique(year_data$region))
)
),
fluidRow(
box(plotOutput("plot1b", height = 250), status = "primary", solidHeader = T, width = 6, title = "Mortality Rate by Year"),
box(title = "Controls", status = "info", solidHeader = T, width = 6,
selectInput("year", "Select Year:", choices = unique(year_data$year_of_hospital_discharge))
)
),
fluidRow(
box(plotOutput("plot1c", height = 250), status = "primary", solidHeader = T, width = 6, title = "Mortality Rate Over Time"),
box(title = "Controls", status = "info", solidHeader = T, width = 6,
selectInput("hospital", "Select Hospital:", choices = unique(year_data$hospital_name))
)
)
),
## Procedures Tab
tabItem(tabName = "widgets",
h1(strong("Procedure Analysis in New York Hospitals"), style = "font-size:24px; text-align:center; margin-bottom: 20px;"),
fluidRow(
box(plotOutput("plot2a", height = 250), status = "primary", solidHeader = T, width = 6, title = "Procedures by X Axis"),
box(title = "Controls", status = "info", solidHeader = T, width = 6,
radioButtons("x", "Select X Axis:", choices = c("year_of_hospital_discharge", "region"), selected = "year_of_hospital_discharge")
)
),
fluidRow(
box(plotOutput("plot2b", height = 250), status = "primary", solidHeader = T, width = 6, title = "Mortality Rate by Procedure"),
box(title = "Controls", status = "info", solidHeader = T, width = 6,
selectInput("p", "Select Year:", choices = unique(year_data$year_of_hospital_discharge))
)
),
fluidRow(
box(plotOutput("plot2c", height = 250), status = "primary", solidHeader = T, width = 6, title = "Procedure Cases per Hospital"),
box(title = "Controls", status = "info", solidHeader = T, width = 6,
selectInput("h", "Select Hospital:", choices = unique(year_data$hospital_name))
)
)
),
## Cases Tab
tabItem(tabName = "cases",
h1(strong("Cases Based on Cardiac Surgery in New York Hospitals"), style = "font-size:24px; text-align:center; margin-bottom: 20px;"),
fluidRow(
box(plotOutput("plot3a", height = 250), status = "primary", solidHeader = T, width = 6, title = "Cases per Year"),
box(title = "Controls", status = "info", solidHeader = T, width = 6,
selectInput("a", "Select Hospital:", choices = unique(year_data$hospital_name))
)
),
fluidRow(
box(plotOutput("plot3b", height = 250), status = "primary", solidHeader = T, width = 6, title = "Cases vs Mortality Rate"),
box(title = "Controls", status = "info", solidHeader = T, width = 6,
selectInput("b", "Select Year:", choices = unique(year_data$year_of_hospital_discharge))
)
)
),
## Maps Tab
tabItem(tabName = "map",
h1(strong("Overall Maps Based on Dataset"), style = "font-size:24px; text-align:center; margin-bottom: 20px;"),
fluidRow(
box(plotOutput("plot4a", height = 450), status = "primary", solidHeader = T, width = 6, title = "Map 1"),
box(plotOutput("plot4b", height = 450), status = "primary", solidHeader = T, width = 6, title = "Map 2")
),
fluidRow(
box(plotOutput("plot4c", height = 450), status = "primary", solidHeader = T, width = 6, title = "Map 3"),
box(plotOutput("plot4d", height = 450), status = "primary", solidHeader = T, width = 6, title = "Map 4")
)
),
## NYC Maps Tab
tabItem(tabName = "nyc",
h1(strong("Maps Zoomed in on New York City"), style = "font-size:24px; text-align:center; margin-bottom: 20px;"),
fluidRow(
box(plotOutput("plot5a", height = 450), status = "primary", solidHeader = T, width = 6, title = "NYC Map 1"),
box(plotOutput("plot5b", height = 450), status = "primary", solidHeader = T, width = 6, title = "NYC Map 2")
),
fluidRow(
box(plotOutput("plot5c", height = 450), status = "primary", solidHeader = T, width = 6, title = "NYC Map 3")
)
)
)
)
)
# Server Function
server <- function(input, output, session) {
session$onSessionEnded(stopApp)
output$plot1a <- renderPlot({
ranger_corps %>%
filter(region == input$region) %>%
ggplot(aes(x = observed_mortality_rate))+
geom_density(color = "black", fill = "steelblue", alpha = 0.6)+
labs(title = "Observed Mortality Rate Distribution by Region",
x = "Mortality Rate",
y = "Proportion of Hospitals in the Region")
})
output$plot1b <- renderPlot({
ranger_corps %>%
filter(year_of_hospital_discharge == input$year) %>%
ggplot(aes(x = observed_mortality_rate))+
geom_density(color = "black", fill = "steelblue", alpha = 0.6)+
labs(title = "Observed Mortality Rate Distribution by Year",
x = "Mortality Rate",
y = "Proportion of Hospitals")
})
output$plot1c <- renderPlot({
ranger_corps %>%
filter(hospital_name == input$hospital) %>%
group_by(year_of_hospital_discharge, hospital_name) %>%
summarize(avg_mortality = mean(observed_mortality_rate), .groups = 'keep') %>%
ggplot(aes(x = as.factor(year_of_hospital_discharge), y = avg_mortality, group = hospital_name))+
geom_line()+
geom_point(na.rm = T)+
labs(title = "Mortality Rate Over Time",
x = "Year",
y = "Mortality Rate")
})
output$plot2a <- renderPlot({ #this is a bigger picture of the two plots shown below
ranger_corps %>%
ggplot(aes_string(x= input$x, fill = "procedure"))+
geom_bar(position="dodge", alpha=0.8, color="black")+
coord_flip() +
labs(x= "Procedure Type", y= "New York Region", fill= "Procedure")
})
output$plot2b <- renderPlot({
ranger_corps %>%
filter(year_of_hospital_discharge == input$p) %>%
group_by(procedure) %>%
summarize(avg_mortality = mean(observed_mortality_rate)) %>%
ggplot(aes(x = reorder(procedure, avg_mortality), y = avg_mortality))+
geom_col(color = "black", fill = "lightblue")+
coord_flip()+
labs(title = "Average Observed Mortality Rate by Procedure",
x = "Procedure",
y = "Mortality Rate")+
theme_light(base_size = 14)
})
output$plot2c <- renderPlot({
ranger_corps %>%
filter(hospital_name == input$h) %>%
group_by(procedure, hospital_name) %>%
summarize(procedure_cases = sum(number_of_cases), .groups = 'keep') %>%
ggplot(aes(x = procedure, y = procedure_cases))+
geom_col(color = "black", fill = "lightblue")+
coord_flip() +
labs(title = "Number of Cases per Procedure",
x = "Procedure",
y = "Number of Cases")+
theme_light(base_size = 14)
})
output$plot3a <- renderPlot({
ranger_corps %>%
filter(hospital_name == input$a) %>%
group_by(year_of_hospital_discharge) %>%
summarize(total_cases_a = sum(number_of_cases)) %>%
ggplot(aes_string(x="year_of_hospital_discharge", y = "total_cases_a"))+
geom_col(alpha=0.8, color="black", fill = "steelblue")+
labs(title = "Number of Cases per Year",
x= "Year",
y= "Number of Cases")+
theme_light(base_size = 14)
})
output$plot3b <- renderPlot({
ranger_corps %>%
filter(year_of_hospital_discharge == input$b) %>%
group_by(facility_id, procedure) %>%
summarize(total_procedures = sum(number_of_cases), avg_mortality = mean(observed_mortality_rate)) %>%
ggplot(aes(x = total_procedures, y = avg_mortality))+
geom_point(color = "olivedrab", na.rm = T) +
labs(title = "Average Mortality Rate compared with Procedure Numbers ",
x = "Total Number of Procedures",
y = "Mortality Rate")+
theme(axis.text.y = element_text(angle = 0, hjust = 1, size = 5))+
theme_classic()+
scale_x_log10()+
geom_smooth(method=lm, se=F, formula = 'y ~ x')
})
output$plot4a <- renderPlot({
ggmap(maptotal) +
geom_point(data = x, aes(facility_longitude, facility_latitude), na.rm= T) + labs(x= "Longitude", y= "Latitude")
})
output$plot4a <- renderPlot({
ggmap(maptotal) +
geom_point(data = x, aes(facility_longitude, facility_latitude, size = 2, color = average_moratality_rate), alpha = 0.8) +
scale_color_gradient(low = "steelblue", high = "midnightblue") +
labs(x= "Longitude", y= "Latitude", title="Cardiac Locations")+labs(colour = "Average Mortality Rate")+labs(legend.text = element_text(size = 14), legend.title = element_text(size = 15))
})
output$plot4b <- renderPlot({
ggmap(maptotal) +
geom_point(data = x, aes(facility_longitude, facility_latitude, color = number_of_cases, size = 2), alpha = 0.8) +
scale_color_gradient(low = "steelblue", high = "midnightblue") +
labs(x= "Longitude", y= "Latitude", title="Cases Distribution") +labs(colour = "Number of Cases")+labs(legend.text = element_text(size = 14), legend.title = element_text(size = 15))
})
output$plot4c <- renderPlot({
ggmap(maptotal) +
geom_point(data = x, aes(facility_longitude, facility_latitude, color = average_moratality_rate, size = 2), alpha = 0.8) +
scale_color_gradient(low = "steelblue", high = "midnightblue") +
labs(x= "Longitude", y= "Latitude", title="Mortality Rate") +labs(colour = "Average Mortality Rate")+labs(legend.text = element_text(size = 14), legend.title = element_text(size = 15))
})
output$plot4d <- renderPlot({
ggmap(maptotal) +
geom_point(data = x, aes(facility_longitude, facility_latitude, color = total_deaths, size = 2), alpha = 0.8) +
scale_color_gradient(low = "steelblue", high = "midnightblue") +
labs(x= "Longitude", y= "Latitude", title="Total Deaths") +labs(colour = "Total Deaths")+labs(legend.text = element_text(size = 14), legend.title = element_text(size = 15))
})
output$plot5a <- renderPlot({
ggmap(mapnyc) +
geom_point(data = x, aes(facility_longitude, facility_latitude, colour = average_moratality_rate,size = 2.5), na.rm= T) + scale_color_gradient(low = "steelblue", high = "midnightblue") +
labs(x= "Longitude", y= "Latitude", title="Average Mortality Rate by Hospital")+labs(colour = "Average Mortality Rate")+labs(legend.text = element_text(size = 14), legend.title = element_text(size = 15))
})
output$plot5b <- renderPlot({
ggmap(mapnyc) +
geom_point(data = x, aes(facility_longitude, facility_latitude, colour = number_of_cases, size = 2.5), na.rm= T) +
scale_color_gradient(low = "steelblue", high = "midnightblue") +
labs(x= "Longitude", y= "Latitude", title="Total Number of Cases")+labs(colour = "Number of Cases")+labs(legend.text = element_text(size = 14), legend.title = element_text(size = 15))
})
output$plot5c <- renderPlot({
ggmap(mapnyc) +
geom_point(data = x, aes(facility_longitude, facility_latitude, colour = total_deaths, size = 2.5), na.rm= T) +
scale_color_gradient(low = "steelblue", high = "midnightblue") +
labs(x= "Longitude", y= "Latitude", title="Total Number of Deaths")+labs(colour = "Total Deaths")+labs(legend.text = element_text(size = 14), legend.title = element_text(size = 15))
})
}
# Run the app
shinyApp(ui, server)